home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d27
/
dspdep.arc
/
CPP1731.RPG
< prev
next >
Wrap
Text File
|
1991-12-04
|
12KB
|
297 lines
/TITLE Display Data Base file dependencies.
*
* Program - CPP1731 (Called by CPP1730)
*
* (c) Copyright 1984 by Q38
*
FCPP1731 CF E WORKSTN
F RRN KSFILE CPP1731D
/SPACE
* Use QADSPDBR to get DSPDBR OUTFILE format.
FQADSPDBRIF E DISK
E FL 21 01 File.Library
E CM 80 01 Command to Exec.
IFILEDS DS
I 01 10 WHRFI
I 11 20 WHRLI
I 21 30 WHRMB
I 31 40 WHRRD
IFILIBR DS
I 01 10 FILE
I 11 20 LIBR
IINTPGM DS
I 01 10 INTP
I 11 20 INTL
I SDS
I *PROGRAM PGMSGQ
I 40 46 MSGID
C *ENTRY PLIST
C PARM FILIBR
C PARM MBR 10
C PARM RCDFMT
C PARM INTPGM
C/SPACE
C *LIKE DEFN FILEDS OLD
C *LIKE DEFN *IN01 SECOND
C MOVEL'0' SECOND
C/SPACE
C* If interupt program requested,
C* build qualified program name.
C INTP IFEQ '*NONE'
C MOVELINTP INTNAM
C ELSE
C INTL IFEQ '*LIBL'
C MOVELINTP INTNAM
C ELSE
C MOVEAINTP FL,1
C Z-ADD1 X
C *BLANK LOKUPFL,X 50
C MOVEL'.' FL,X
C ADD 1 X
C MOVEAINTL FL,X
C MOVEAFL,1 INTNAM 21
C END
C END
C Z-ADD0 X
C MOVEA*BLANKS FL
C MBR IFEQ '*NONE'
C MOVEL'1' *IN65
C MOVEL'1' *IN42
C END
C/SPACE
C READF TAG
C READ QADSPDBR 32
C *IN32 IFEQ '0'
C SECOND IFEQ '1'
C FILEDS CABNEOLD DSPDBR
C ELSE
C MOVELFILEDS OLD
C MOVEL'1' SECOND
C END
C ELSE
C/SPACE
C RRN CABLT1 EXIT
C GOTO DSPDBR
C END
C/SPACE
C ADD 1 RRN 50
C RRN IFEQ 1
C MOVEL'0' *IN21
C WRITECPP1731C
C END
C/SPACE
C WHTYPE IFEQ 'D'
C MOVEL'DATA' TYPE
C ELSE
C WHTYPE IFEQ 'A'
C MOVEL'ACCESS' TYPE
C ELSE
C MOVEL'*FILE' TYPE
C END
C END
C MOVELWHREFI OLDFIL
C MOVELWHREMB OLDMBR
C/SPACE
C WRITECPP1731D
C GOTO READF
C/SPACE
C DSPDBR TAG
C *IN21 IFEQ '0'
C WRITECPP1731B
C *IN32 IFEQ '0'
C MOVELFILEDS OLD Save next DS
C READPQADSPDBR 32
C END
C MOVEL'1' *IN21
C END
/SPACE
C WRITEMSGCTL
C EXFMTCPP1731C
C *IN01 CABEQ'1' EXIT
C MOVEL'0' *IN53
C CALL 'CLRPGMQ' 53
C/SPACE
C *IN05 IFEQ '1'
C Z-ADD0 RRN
C MOVEL'0' SECOND
C GOTO READF
C END
C/SPACE
C READC TAG
C MOVEL'0' *IN53
C READCCPP1731D 33
C *IN33 CABEQ'1' DSPDBR
/SPACE
C WHREFI IFNE '*Deleted'
C WHREMB IFNE '*Removed'
C MOVEA*ALL' ' CM
/SPACE
* If an OPTion was entered, then
* call interupt program, passing to it
* the File/member data.
*
* Q38 has supplied the follow in-line funtions.
* 8 - RMVM Remove member.
* 9 - DLTF Delete file.
* MDT of File Rename File
* MDT of Member Rename Member
/SPACE
C *IN61 CASEQ'1' RNMOBJ Rename File
C *IN62 CASEQ'1' RNMM Rename Member
C OPT CASEQ'8' RMVM Remove member
C OPT CASEQ'9' DLTF Delete file.
C OPT CASNE*BLANK EXECPG Interupt prog.
C END
/SPACE
C END
C END
/SPACE
C MOVEL' ' OPT
C UPDATCPP1731D
C MOVEA'00' *IN,41
C GOTO READC
C EXIT TAG
C MOVEL'1' *INLR
/SPACE
CSR RNMOBJ BEGSR
*
C WHREFI IFNE '*Deleted'
C WHREFI ANDNE*BLANKS
*
C MOVEA*BLANKS FL
C MOVEAOLDFIL FL
C Z-ADD1 X 50
C *BLANK LOKUPFL,X 50
C MOVEL'.' FL,X
C ADD 1 X
C MOVEAWHRELI FL,X
*
C MOVEA*BLANKS CM
C MOVEA'RNMOBJ' CM,1
C MOVEAFL,1 CM,11
C MOVEA'*FILE' CM,35
C MOVEAWHREFI CM,45
*
C EXSR EXECMD EXECUTE COMMAND
C *IN53 IFEQ '0'
C MOVE WHREFI OLDFIL
C ELSE
C MOVE OLDFIL WHREFI
C END
C END
*
CSR ENDRNM ENDSR
/SPACE
CSR RNMM BEGSR
*
C WHREFI IFNE '*Deleted'
C WHREMB IFNE '*Removed'
*
C MOVEA*BLANKS FL
C MOVEAWHREFI FL
C Z-ADD1 X 50
C *BLANK LOKUPFL,X 50
C MOVEL'.' FL,X
C ADD 1 X
C MOVEAWHRELI FL,X
/SPACE
C MOVEA*BLANKS CM
C MOVEA'RNMM ' CM,1
C MOVEAFL,1 CM,11
C MOVEAOLDMBR CM,35
C MOVEAWHREMB CM,60
/SPACE
C EXSR EXECMD EXECUTE COMMAND
C *IN53 IFEQ '0'
C MOVE WHREMB OLDMBR
C ELSE
C MOVE OLDMBR WHREMB
C END
C END
C END
/SPACE
CSR ENDMBR ENDSR
/SPACE
CSR RMVM BEGSR
/SPACE
C WHREFI IFNE '*Deleted'
C WHREMB IFNE '*Removed'
C MOVEA*BLANKS FL
C MOVEAWHREFI FL
C Z-ADD1 X 50
C *BLANK LOKUPFL,X 50
C MOVEL'.' FL,X
C ADD 1 X
C MOVEAWHRELI FL,X
/SPACE
C MOVEA*BLANKS CM
C MOVEA'RMVM ' CM
C MOVEAFL,1 CM,11
C MOVEAWHREMB CM,35
C EXSR EXECMD EXECUTE COMMAND
C *IN53 IFEQ '0'
C MOVEL'1' *IN42
C MOVE *BLANKS WHREMB
C MOVEL'*Removed'WHREMB
C END
C END
C END
/SPACE
CSR ENDRMV ENDSR
/SPACE
CSR DLTF BEGSR
/SPACE
C WHREFI IFNE '*Deleted'
C MOVEA*BLANKS FL
C MOVEAWHREFI FL
C Z-ADD1 X 50
C *BLANK LOKUPFL,X 50
C MOVEL'.' FL,X
C ADD 1 X
C MOVEAWHRELI FL,X
/SPACE
C MOVEA*BLANKS CM
C MOVEA'DLTF ' CM,1
C MOVEAFL,1 CM,11
C EXSR EXECMD EXECUTE COMMAND
C *IN53 IFEQ '0'
C MOVEA'11' *IN,41
C MOVE *BLANKS WHREFI
C MOVEL'*Deleted'WHREFI
C END
C END
/SPACE
CSR ENDDLT ENDSR
/SPACE
CSR EXECMD BEGSR
/SPACE
C MOVEACM CMD
C CALL 'QCAEXEC' 53
C PARM CMD 80
C PARM 80 LENGTH 155
/SPACE
CSR ENDCMD ENDSR
/SPACE
CSR EXECPG BEGSR
/SPACE
C *LIKE DEFN WHREFI FIL
C *LIKE DEFN WHRELI LIB
C *LIKE DEFN WHREMB MEMBER
C *LIKE DEFN WHRRD RECD
C *LIKE DEFN WHTYPE DEPTYP
C *LIKE DEFN OPT OPTION
/SPACE
C INTNAM IFEQ '*NONE'
C MOVEL'1' *IN53
C ELSE
C CALL INTNAM 53
C PARM OPT OPTION
C WHREFI PARM WHREFI FIL
C WHRELI PARM WHRELI LIB
C WHREMB PARM WHREMB MEMBER
C WHRRD PARM WHRRD RECD
C PARM WHTYPE DEPTYP
C END
/SPACE
CSR ENDINT ENDSR